Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue35/pageprnt/PAGEPRNT.ZIP/PagePrnt/Beta/TestIt/Unit1.pas

Pascal/Delphi Source File | 1997-10-30 | 6KB | 186 lines

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PagePrnt, ExtCtrls, StdCtrls, Buttons;

type
  TMainForm = class(TForm)
    Prn: TPagePrinter;
    Panel1: TPanel;
    btnPreview: TButton;
    lblPage: TLabel;
    btnNextPage: TSpeedButton;
    btnPrevPage: TSpeedButton;
    Label4: TLabel;
    ZoomList: TComboBox;
    ZoomTimer: TTimer;
    btnPrint: TButton;
    procedure btnPreviewClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnNextPageClick(Sender: TObject);
    procedure btnPrevPageClick(Sender: TObject);
    procedure ZoomListKeyPress(Sender: TObject; var Key: Char);
    procedure ZoomListClick(Sender: TObject);
    procedure ZoomTimerTimer(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
    procedure PrnGetCellFormat(Sender: TObject; const Col: Cardinal;
      var ColInfo: TTableLineColumnInfo);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.btnPreviewClick(Sender: TObject);
var
   Bitmap: TBitmap;
begin
     with Prn do
     begin
          BeginDoc;
          //Use WriteTableLine
          WriteTableLine('Tiny but cute words are best.|Tiny but cute words are best.|Tiny but cute words are best.');
          WriteTableLine('A man, a plan, a canal: Panama!|A man, a plan, a canal: Panama!|A man, a plan, a canal: Panama!');
          NewLine;
          //Use Write, NewLine, and WriteLine
          Write('First Font');
          Font.Size:=Font.Size+10;
          Write(' Second Font');
          Font.Size:=Font.Size+10;
          Write(' 3rd Font');
          Font.Size:=Font.Size-10;
          Write(' Fourth Font');
          NewLine;
          WriteLine('We can use a NewLine after using Write');
          NewLine;
          //Use WriteLines
          Font.Size:=10;
          WriteLines(False);
          //Do some canvas doodling.
          NewPage;
          WriteLine('These figures will appear in the preview, but they may or may not print on your printer because of limitations with dithering colors in various printer drivers.');
          Canvas.Pen.Color := clRed;
          Canvas.PolyLine([Point(600, 600), Point(900, 600), Point(900, 900), Point(600, 900), Point(750, 750), Point(600, 600)]);
          Canvas.Brush.Color:=clWhite;
          Bitmap:=TBitmap.Create;
          try
             Bitmap.LoadFromFile('TestIt.bmp');
             Canvas.BrushCopy( Rect(1000, 1000, 1000+4*Bitmap.Width, 1000+4*Bitmap.Height),
                               Bitmap, Rect(0,0,Bitmap.Width, Bitmap.Height), clLime);
          finally
                 Bitmap.Free;
          end;
          EndDoc;
          lblPage.Caption:=IntToStr(PageNumber)+' of '+IntToStr(PageCount);
     end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
     lblPage.Caption:=IntToStr(Prn.PageNumber)+' of '+IntToStr(Prn.PageCount);
end;

procedure TMainForm.btnNextPageClick(Sender: TObject);
begin
     if Prn.PageNumber < Prn.PageCount then
     begin
          Prn.PageNumber:=Prn.PageNumber+1;
          FormShow(Sender);
     end;
end;

procedure TMainForm.btnPrevPageClick(Sender: TObject);
begin
     if Prn.PageNumber > 1 then
     begin
          Prn.PageNumber:=Prn.PageNumber-1;
          FormShow(Sender);
     end;
end;

procedure TMainForm.ZoomListKeyPress(Sender: TObject; var Key: Char);
begin
     if Key = #13 then
     begin
          try
             Prn.ZoomPercent:=StrToInt(ZoomList.Text);
          except
                on EConvertError do ;
          end;
          Key:=#0;
     end;
end;

procedure TMainForm.ZoomListClick(Sender: TObject);
begin
     case ZoomList.ItemIndex of
          0: Prn.ZoomPercent := 200;
          1: Prn.ZoomPercent := 175;
          2: Prn.ZoomPercent := 150;
          3: Prn.ZoomPercent := 125;
          4: Prn.ZoomPercent := 100;
          5: Prn.ZoomPercent := 50;
          6: Prn.ZoomToWidth;
          7: Prn.ZoomToHeight;
          8: Prn.ZoomToFit;
     end;
     ZoomTimer.Enabled:=True;
end;

procedure TMainForm.ZoomTimerTimer(Sender: TObject);
begin
     {This kludge is necessary to display the actual zoom percent
     after Fit To Width, Fit To Height, or Whole Page are chosen.
     If you assign something (e.g. ZoomPercent) to TComboBox.Text
     inside of TComboBox.OnClick, it gets overwritten with the
     selected item's text right after the OnClick handler returns.
     To get around this, I made this timer update the text property
     after all the TComboBox event handling is finished.
     If someone knows a better way, please let me know!}
     ZoomTimer.Enabled:=False;
     ZoomList.Text:=IntToStr(Prn.ZoomPercent)+'%';
end;

procedure TMainForm.btnPrintClick(Sender: TObject);
begin
     if Prn.PageCount > 0 then
     begin
          if not Prn.Print then
             MessageDlg('You cancelled printing.', mtInformation, [mbOk], 0);
     end
     else
         MessageDlg('There is nothing to print.  Press preview first.',
             mtInformation, [mbOk], 0);
end;

procedure TMainForm.PrnGetCellFormat(Sender: TObject; const Col: Cardinal;
  var ColInfo: TTableLineColumnInfo);
begin
     ColInfo.Width:=2;
     if Col = 2 then
     begin
          ColInfo.DrawGrid:=True;
          ColInfo.Alignment:=taRightJustify;
          ColInfo.Text:='This column is formatted by OnGetCellFormat';
          Prn.Font.Style:=[fsBold];
          Prn.Font.Size:=12;
     end
     else
     begin
          Prn.Font.Style:=[];
          Prn.Font.Size:=10;
     end;
end;

end.